home *** CD-ROM | disk | FTP | other *** search
/ Just Call Me Internet / Just Call Me Internet.iso / prog / atari / m2 / cat3src / putz / putzgrou.i < prev    next >
Text File  |  1997-10-26  |  62KB  |  2,090 lines
  1. IMPLEMENTATION MODULE PutzGroup;
  2.  
  3. FROM SYSTEM IMPORT ADDRESS, ADR, CADR, ASSEMBLER, CAST, TSIZE;
  4.  
  5. (* MM2-Module *)
  6. IMPORT Block, BinOps, Strings, StrConv, Lists, Storage;
  7.  
  8. (* CAT-Module *)
  9. IMPORT ZCalcCrc, dataSys, MTPaths, CatFiles, GroupSelect;
  10. FROM Void       IMPORT v;
  11. FROM dataSys    IMPORT posType;
  12.  
  13. (* Magic-Module *)
  14. IMPORT MagicDOS, mtAlerts, MagicCookie, mtTextfiles;
  15.  
  16. (* Putz-Module *)
  17. IMPORT PutzAction, PutzTypes, PutzLog;
  18. FROM PutzTypes IMPORT delState, totalEntry, putzList;
  19.  
  20. CONST deletedText = '<gel”scht von CatPutz '+PutzTypes.xVersion+'>'+12C+0C;
  21.  
  22. CONST   fDiskFull   = -1004;
  23.         fReadError  = -1005;
  24.  
  25. TYPE    fileHandle  = INTEGER;  
  26.  
  27. VAR 
  28.       putzOpts  : PutzTypes.putzOptsRec;
  29.   
  30. VAR   datFile, 
  31.       parFile, 
  32.       tabFile   : fileHandle;
  33.       newDat, 
  34.       newPar, 
  35.       newTab    : fileHandle;
  36.       
  37.       datSize   : LONGCARD;
  38.       
  39.       newNums   : ARRAY [0..65535] OF CARDINAL;
  40.       
  41.       tabArray  : PutzTypes.ptrTabArray;
  42.       parArray  : PutzTypes.parFilePtr;
  43.       
  44.       newTabArray : PutzTypes.ptrTabArray;
  45.       newParArray : PutzTypes.parFilePtr;
  46.       
  47.       datBuffer: POINTER TO ARRAY[0L..$FFFFFFFFL] OF CHAR;
  48.       
  49.       buf      : POINTER TO ARRAY [0..79999] OF CHAR; (* globaler Buffer *)
  50.       
  51.       datBuffered,
  52.       tabBuffered,
  53.       parBuffered : BOOLEAN;
  54.       
  55.       msgCounter  : CARDINAL;    (* Counter fr neue Messagefiles *)
  56.       
  57.       bRead     : LONGCARD;
  58.       
  59.       badMsg,
  60.       partDeleted,
  61.       deleted       : CARDINAL;
  62.       firstUnread,
  63.       unreadCounter : CARDINAL;
  64.       
  65.       currentGroup  : INTEGER;
  66.       AnzMessages   : CARDINAL;
  67.       
  68.       hasFileLocking: BOOLEAN;
  69.       stopDelete    : BOOLEAN;
  70.  
  71. PROCEDURE MFree (VAR adr : ADDRESS) : BOOLEAN;
  72.   VAR res : BOOLEAN;
  73. BEGIN
  74.   res := MagicDOS.Mfree (adr);
  75.   adr := NIL;
  76.   RETURN res;
  77. END MFree;
  78.         
  79. PROCEDURE MemAvail () : LONGCARD;
  80. BEGIN
  81.   RETURN LONGCARD(MagicDOS.Malloc (MagicDOS.Minus1));
  82. END MemAvail;
  83.  
  84. PROCEDURE WriteBytes (f: fileHandle; addr: ADDRESS; bytes: LONGCARD);
  85. (* Speichert die Daten ab Adresse 'addr' mit der L„nge 'bytes' in Byte *)
  86.   VAR count : LONGCARD;
  87.       state : INTEGER;
  88. BEGIN
  89.   count := bytes;
  90.   MagicDOS.Fwrite (f, count, addr);
  91.   IF count # bytes
  92.   THEN
  93.     IF LONGINT (count) < 0
  94.     THEN
  95.       (* GEMDOS-Fehler *)
  96.       state := VAL (INTEGER, SHORT(count));
  97.     ELSE
  98.       state := fDiskFull;
  99.     END;
  100.   ELSE
  101.     state := 0;
  102.   END;
  103.   IF state < 0 THEN
  104.     CatFiles.ErrorAlert (state);
  105.     stopDelete := TRUE;
  106.   END;
  107. END WriteBytes;
  108.  
  109. PROCEDURE ReadBytes ( f : fileHandle; addr : ADDRESS; bytes : LONGCARD;
  110.                       VAR bytesRead: LONGCARD);
  111.   VAR state : INTEGER;
  112. BEGIN
  113.   bytesRead := bytes;
  114.   MagicDOS.Fread (f, bytesRead, addr);
  115.   IF bytesRead # bytes
  116.   THEN
  117.     IF LONGINT (bytesRead) < 0
  118.     THEN 
  119.       (* GEMDOS-Fehler *)
  120.       state := VAL (INTEGER, SHORT(bytesRead));
  121.     ELSE
  122.       state := fReadError;
  123.     END;
  124.   ELSE
  125.     state := 0;
  126.   END;
  127.   IF state < 0 THEN
  128.     CatFiles.ErrorAlert (state);
  129.     stopDelete := TRUE;
  130.   END;
  131. END ReadBytes;
  132.   
  133. VAR buffer : POINTER TO ARRAY [$0L..$FFFFFFFFL] OF CHAR;
  134.     bufPos, bufSize : LONGCARD;
  135.     bufHdl : fileHandle;
  136.     bytesWritten : LONGCARD;
  137.  
  138. PROCEDURE FilePos (f: fileHandle): LONGCARD;
  139. (*
  140.  * Liefert aktuelle Byteposition des Dateizeigers.
  141.  *)
  142.  VAR fp : LONGCARD;
  143. BEGIN
  144.   IF (f = bufHdl)
  145.   THEN 
  146.     fp := bytesWritten
  147.   ELSE
  148.     fp := MagicDOS.Fseek (0, f, MagicDOS.SeekPos);
  149.     IF (f = bufHdl) & (buffer # NIL) & (bufSize > 0)
  150.     THEN
  151.       INC (fp, bufPos);
  152.     END;
  153.   END;
  154.   RETURN fp;
  155. END FilePos;
  156.  
  157. PROCEDURE FileSize (f: fileHandle): LONGCARD;
  158.   VAR fp: LONGCARD;
  159.       size : LONGCARD;
  160. BEGIN
  161.   fp := MagicDOS.Fseek (0, f, MagicDOS.SeekPos);
  162.   IF fp # 0
  163.   THEN
  164.     v.lcard := MagicDOS.Fseek (0, f, MagicDOS.SeekStart);
  165.   END;
  166.   size := MagicDOS.Fseek (0, f, MagicDOS.SeekEnd);
  167.   (* Position wieder restaurieren *)
  168.   fp := MagicDOS.Fseek (fp, f, MagicDOS.SeekStart);
  169.   RETURN size;
  170. END FileSize;
  171.  
  172. PROCEDURE OpenFile (VAR f: fileHandle; REF name: ARRAY OF CHAR);
  173.   VAR mode : BITSET;
  174. BEGIN
  175.   mode := {MagicDOS.ReadWrite};
  176.   IF hasFileLocking
  177.   THEN
  178.     (* Jeglichen anderen Zugriff verbieten *)
  179.     INCL (mode, MagicDOS.ShareFlag1);
  180.   END;
  181.   f := MagicDOS.Fopen  (name, mode);
  182. END OpenFile;
  183.  
  184. PROCEDURE CreateFile (VAR f: fileHandle; REF name: ARRAY OF CHAR);
  185. BEGIN
  186.   f := MagicDOS.Fcreate  (name, {});
  187. END CreateFile;
  188.  
  189. PROCEDURE WriteBuffered (fHdl : fileHandle; buf : ADDRESS; l : LONGCARD);
  190.   VAR (*$Reg*) remain  : LONGCARD;
  191.       (*$Reg*) wrBytes : LONGCARD;
  192.       (*$Reg*) ptr     : POINTER TO ARRAY [0..$FFFFFFFF] OF CHAR;
  193. BEGIN
  194.   IF bufSize = 0
  195.   THEN
  196.     WriteBytes (fHdl, buf, l);
  197.   ELSIF l+bufPos > bufSize
  198.   THEN
  199.     remain := l;
  200.     REPEAT
  201.       Block.Copy (buf, bufSize-bufPos, ADR(buffer^[bufPos]));
  202.       INC (buf, bufSize-bufPos);
  203.       DEC (remain, bufSize-bufPos);
  204.       INC(bufPos, bufSize-bufPos);
  205.       wrBytes := bufPos;
  206.       WriteBytes (fHdl, buffer, bufPos);
  207.       IF bufPos # wrBytes
  208.       THEN
  209.         INC (bytesWritten, l - remain);
  210.         l := bufPos;
  211.         RETURN
  212.       END;
  213.       bufPos := 0;
  214.     UNTIL remain < bufSize;
  215.     Block.Copy (buf, remain, ADR(buffer^[bufPos]));
  216.     bufPos := remain;
  217.   ELSE
  218.     Block.Copy (buf, l, ADR(buffer^[bufPos]));
  219.     INC(bufPos,l);
  220.   END;
  221.   INC (bytesWritten, l);
  222. END WriteBuffered;
  223.  
  224. PROCEDURE MakeWriteBuffer (fHdl : fileHandle);
  225. BEGIN
  226.   buffer := NIL;
  227.   bufSize := $80000;
  228.   WHILE (buffer = NIL) & (bufSize > 0) DO
  229.     buffer := MagicDOS.Malloc ( bufSize);
  230.     IF buffer = NIL THEN DEC(bufSize, $1000) END;
  231.   END;
  232.   PutzLog.putTime();
  233.   IF bufSize = 0
  234.   THEN
  235.     buffer := NIL;
  236.     PutzLog.WriteLine ('Zuwenig Speicher fr Writebuffer');
  237.   ELSE
  238.     bufHdl := fHdl;
  239.     PutzLog.WriteCard (bufSize);
  240.     PutzLog.WriteLine (' Bytes Writebuffer angelegt');
  241.   END;
  242.   bufPos := 0;
  243.   bytesWritten := 0;
  244. END MakeWriteBuffer;
  245.  
  246. PROCEDURE CloseWriteBuffer (fHdl : fileHandle);
  247. BEGIN
  248.   IF (bufSize > 0) & (bufPos > 0) & (buffer # NIL) & (fHdl = bufHdl)
  249.   THEN
  250.     (* Buffer noch flushen *)
  251.     IF ~stopDelete THEN WriteBytes (fHdl, buffer, bufPos) END;
  252.     v.bool := MFree (buffer);
  253.     buffer := NIL;
  254.     bufPos := 0;
  255.   END;
  256. END CloseWriteBuffer;
  257.  
  258. PROCEDURE getGroupMsgs() : LONGCARD;
  259. BEGIN
  260.   RETURN (FileSize(parFile)- dataSys.dbHeaderLength) DIV TSIZE(dataSys.pBlock);
  261. END getGroupMsgs;
  262.  
  263. PROCEDURE getGroupBytes() : LONGCARD;
  264. BEGIN
  265.   RETURN FileSize (datFile);
  266. END getGroupBytes;
  267.  
  268.       (* L”sch-Funktionen  *)
  269. PROCEDURE GetDat (f : fileHandle; start : LONGCARD; buf : ADDRESS;
  270.                   length : LONGCARD; VAR bytesRead : LONGCARD);
  271.     VAR sAddr : ADDRESS;
  272. BEGIN
  273.   IF (start < datSize) & 
  274.      (start + length <= datSize)
  275.   THEN
  276.     IF datBuffered
  277.     THEN
  278.       sAddr := datBuffer+ADDRESS(start);
  279.       Block.Copy (sAddr, length, buf);
  280.       bytesRead := length;
  281.     ELSE
  282.       start := MagicDOS.Fseek (start, f, MagicDOS.SeekStart);
  283.       ReadBytes (f, buf, length, bytesRead);
  284.     END;
  285.   ELSE
  286.     bytesRead := 0;
  287.   END;
  288. END GetDat;
  289.  
  290. PROCEDURE CopyTab (index : CARDINAL);
  291.   VAR theCrc : CARDINAL;
  292.       bytesRead: LONGCARD;
  293. BEGIN
  294.   IF tabBuffered
  295.   THEN
  296.     newTabArray^[msgCounter] := tabArray^[index];
  297.   ELSE
  298.     v.lcard := MagicDOS.Fseek (LONG(index)*2L, tabFile, MagicDOS.SeekStart);
  299.     ReadBytes (tabFile, ADR(theCrc), 2, bytesRead);
  300.     WriteBytes (newTab, ADR(theCrc), 2);
  301.   END;
  302. END CopyTab;
  303.  
  304. PROCEDURE CopyParam (VAR param : dataSys.pBlock);
  305. BEGIN
  306.   (* Neue CRC berechnen *)
  307.   param.crc := ZCalcCrc.CalcCrcArray(ADR(param)+ADDRESS(2), SHORT(TSIZE(dataSys.pBlock))-2);
  308.   IF parBuffered
  309.   THEN
  310.     newParArray^.params[msgCounter] := param;
  311.   ELSE
  312.     WriteBytes (newPar, ADR(param), TSIZE(dataSys.pBlock));
  313.   END;
  314. END CopyParam;
  315.  
  316. PROCEDURE partDelete (idx : CARDINAL; VAR param : dataSys.pBlock);
  317.   VAR oldNum : CARDINAL;
  318.       newStart : LONGCARD;
  319.       dupeInfo : dataSys.dupeInfoType;
  320. BEGIN
  321.   WITH param DO
  322.     (* Erst mal auf gltige Werte prfen *)
  323.     IF (Start < datSize) & 
  324.        (hLength < 4096) & 
  325.        (idLength < 1024) & 
  326.        (Start+LONG(hLength)+LONG(Length) <= datSize)
  327.     THEN 
  328.       oldNum := idx;
  329.       newNums[idx] := msgCounter;
  330.       IF ~(dataSys.bGelesen IN bits)
  331.       THEN
  332.         IF (firstUnread = dataSys.empty)
  333.         THEN
  334.           firstUnread := msgCounter;
  335.         END;
  336.         INC (unreadCounter);
  337.       END;
  338.       (* Kopieren der einzelnen Datei-Teile *)
  339.       (* zuerst TAB-Datei *)
  340.       CopyTab (oldNum);
  341.       IF stopDelete THEN RETURN END;
  342.     
  343.       (* Jetzt DAT-Datei kopieren *)
  344.       GetDat (datFile, Start, buf, LONG(hLength)+LONG(Length), bRead);
  345.       IF bRead # LONG(hLength) + LONG(Length)
  346.       THEN
  347.         stopDelete := TRUE;
  348.       END;
  349.       GetDat (datFile, Start + LONG(hLength) + LONG(Length), ADR(dupeInfo), TSIZE(dataSys.dupeInfoType), bRead);
  350.       IF bRead # TSIZE (dataSys.dupeInfoType)
  351.       THEN
  352.         stopDelete := TRUE;
  353.       END;
  354.       newStart := FilePos (newDat);
  355.       (* Redundaten Infos anpassen *)
  356.       dupeInfo.Datum := Datum;
  357.       dupeInfo.items := items;
  358.       dupeInfo.bits  := bits;
  359.       dupeInfo.hLength  := hLength;
  360.       dupeInfo.idLength := idLength;
  361.       dupeInfo.Start  := newStart;
  362.       dupeInfo.setTerminator := dataSys.Terminator;
  363.       IF Length > LENGTH (deletedText)
  364.       THEN
  365.         Length := LENGTH (deletedText);
  366.         dupeInfo.Length := Length;
  367.         WriteBuffered (newDat, buf, hLength);
  368.         IF stopDelete THEN RETURN END;
  369.         WriteBuffered (newDat, CADR(deletedText), Length);
  370.         IF stopDelete THEN RETURN END;
  371.         WriteBuffered (newDat, ADR(dupeInfo), TSIZE(dataSys.dupeInfoType));
  372.         IF stopDelete THEN RETURN END;
  373.       ELSE
  374.         dupeInfo.Length := Length;
  375.         WriteBuffered (newDat, buf, LONG(hLength)+LONG(Length));
  376.         IF stopDelete THEN RETURN END;
  377.         WriteBuffered (newDat, ADR(dupeInfo), TSIZE(dataSys.dupeInfoType));
  378.         IF stopDelete THEN RETURN END;
  379.       END;
  380.     
  381.       (* Und jetzt noch PAR-Datei *)
  382.       Start := newStart;
  383.       KomCount := 0;
  384.     
  385.       CopyParam(param);
  386.       INC(msgCounter);
  387.       INC(partDeleted);
  388.     ELSE
  389.       newNums[idx] := dataSys.notSaved;
  390.       INC (badMsg);
  391.     END;
  392.   END;
  393. END partDelete;
  394.  
  395. PROCEDURE noDelete (idx : CARDINAL; VAR param : dataSys.pBlock);
  396.   VAR oldNum : CARDINAL;
  397.       newStart : LONGCARD;
  398.       dupeInfo : dataSys.dupeInfoType;
  399. BEGIN
  400.   WITH param DO
  401.     (* Erst mal auf gltige Werte prfen *)
  402.     IF (Start < datSize) & 
  403.        (hLength < 4096) & 
  404.        (idLength < 1024) & 
  405.        (Start+LONG(hLength)+LONG(Length) <= datSize)
  406.     THEN 
  407.       oldNum := idx;
  408.       newNums[idx] := msgCounter;
  409.  
  410.       IF ~(dataSys.bGelesen IN bits)
  411.       THEN
  412.         IF (firstUnread = dataSys.empty)
  413.         THEN
  414.           firstUnread := msgCounter;
  415.         END;
  416.         INC (unreadCounter);
  417.       END;
  418.       
  419.       (* Kopieren der einzelnen Datei-Teile *)
  420.       (* zuerst TAB-Datei *)
  421.       CopyTab (oldNum);
  422.       IF stopDelete THEN RETURN END;
  423.       
  424.       (* Jetzt DAT-Datei kopieren *)
  425.       GetDat (datFile, Start, buf, LONG(hLength)+LONG(Length), bRead);
  426.       IF bRead # LONG(hLength) + LONG(Length)
  427.       THEN
  428.         stopDelete := TRUE;
  429.       END;
  430.       GetDat (datFile, Start + LONG(hLength) + LONG(Length), ADR(dupeInfo), TSIZE(dataSys.dupeInfoType), bRead);
  431.       IF bRead # TSIZE (dataSys.dupeInfoType)
  432.       THEN
  433.         stopDelete := TRUE;
  434.       END;
  435.       newStart := FilePos (newDat);
  436.       (* redundante Infos anpassen *)
  437.       dupeInfo.Datum := Datum;
  438.       dupeInfo.items := items;
  439.       dupeInfo.bits  := bits;
  440.       dupeInfo.hLength  := hLength;
  441.       dupeInfo.idLength := idLength;
  442.       dupeInfo.Length := Length;
  443.       dupeInfo.Start  := newStart;
  444.       dupeInfo.setTerminator := dataSys.Terminator;
  445.       WriteBuffered (newDat, buf, LONG(hLength)+LONG(Length));
  446.       IF stopDelete THEN RETURN END;
  447.       WriteBuffered (newDat, ADR(dupeInfo), TSIZE(dataSys.dupeInfoType));
  448.       IF stopDelete THEN RETURN END;
  449.       
  450.       (* Und jetzt noch PAR-Datei *)
  451.       Start := newStart;
  452.       KomCount := 0;
  453.       CopyParam (param);
  454.       INC(msgCounter);
  455.     ELSE
  456.       newNums[idx] := dataSys.notSaved;
  457.       INC (badMsg);
  458.     END;
  459.   END;
  460. END noDelete;
  461.  
  462. PROCEDURE totalDelete (idx : CARDINAL; VAR param : dataSys.pBlock);
  463. BEGIN
  464.   newNums[idx] := dataSys.notSaved;
  465.   INC (deleted);
  466. END totalDelete;
  467.  
  468. PROCEDURE badDelete (idx : CARDINAL; VAR param : dataSys.pBlock);
  469. BEGIN
  470.   newNums[idx] := dataSys.notSaved;
  471.   INC (badMsg);
  472. END badDelete;
  473.  
  474. PROCEDURE buildName (number: INTEGER; VAR gName : ARRAY OF CHAR);
  475. BEGIN
  476.   IF number # dataSys.private
  477.   THEN
  478.     IF number <= 100
  479.     THEN
  480.       Strings.Concat ('gruppe', StrConv.NumToStr(number-1,10,2,'0'), gName, v.bool);
  481.     ELSE
  482.       Strings.Concat ('grupp', StrConv.NumToStr(number-1,10,3,'0'), gName, v.bool);
  483.     END;
  484.   ELSE
  485.     Strings.Assign ('private', gName,v.bool);
  486.   END;
  487. END buildName;
  488.  
  489. PROCEDURE openGroup;
  490.   VAR datName,
  491.       tabName,
  492.       parName : ARRAY [0..255] OF CHAR;
  493.       gName   : ARRAY [0..255] OF CHAR;
  494.       bRead   : LONGCARD;
  495.       fHeader : dataSys.FileHeaderType;
  496. BEGIN
  497.   buildName (currentGroup, gName);
  498.   Strings.Concat (MTPaths.DataPath, gName, datName, v.bool);
  499.   Strings.Assign (datName, parName, v.bool);
  500.   Strings.Assign (datName, tabName, v.bool);
  501.   Strings.Append ('.par',parName, v.bool);
  502.   Strings.Append ('.dat',datName, v.bool);
  503.   Strings.Append ('.tab',tabName, v.bool);
  504.   OpenFile (parFile, parName);
  505.   OpenFile (tabFile, tabName);
  506.   OpenFile (datFile, datName);
  507.   IF (parFile < 0) OR (tabFile < 0) OR (datFile < 0)
  508.   THEN
  509.     v.int := mtAlerts.Alert (1,"[3][CATPUTZ:|Die Gruppe kann|nicht ge”ffnet werden!][[Abbruch]");
  510.     stopDelete := TRUE;
  511.     RETURN
  512.   END;
  513.   ReadBytes (parFile, ADR (fHeader), SIZE(fHeader), bRead);
  514.   IF (fHeader.CatMagic # dataSys.standardHeader.CatMagic) OR
  515.      (fHeader.Version # dataSys.standardHeader.Version) OR
  516.      (fHeader.VersionMagic # dataSys.standardHeader.VersionMagic)
  517.   THEN
  518.     v.int := mtAlerts.Alert (1, "[3][CATPUTZ:|Keine oder kaputte |CAT-Datenbank! |Header nicht in Ordnung!][[Abbruch]");
  519.     stopDelete := TRUE;
  520.   END;
  521.   v.lcard := MagicDOS.Fseek (0L, parFile, MagicDOS.SeekStart);
  522. END openGroup;
  523.  
  524. PROCEDURE closeGroup;
  525. BEGIN
  526.   v.int := MagicDOS.Fclose (parFile);
  527.   v.int := MagicDOS.Fclose (datFile);
  528.   v.int := MagicDOS.Fclose (tabFile);
  529. END closeGroup;
  530.  
  531. PROCEDURE createNewFiles ();
  532.  VAR datName,
  533.       tabName,
  534.       parName : ARRAY [0..255] OF CHAR;
  535.       gName   : ARRAY [0..255] OF CHAR;
  536. BEGIN
  537.   buildName (currentGroup, gName);
  538.   Strings.Concat (PutzTypes.tmpPath, gName, datName, v.bool);
  539.   Strings.Assign (datName, parName, v.bool);
  540.   Strings.Assign (datName, tabName, v.bool);
  541.   Strings.Append ('.pa',parName, v.bool);
  542.   Strings.Append ('.da',datName, v.bool);
  543.   Strings.Append ('.ta',tabName, v.bool);
  544.   CreateFile (newPar, parName);
  545.   CreateFile (newTab, tabName);
  546.   CreateFile (newDat, datName);
  547.   IF (newPar < 0) OR (newTab < 0) OR (newDat < 0)
  548.   THEN
  549.     v.int := mtAlerts.Alert (1,"[3][CATPUTZ:|Kann tempor„re Dateien|nicht anlegen!][[Abbruch]");
  550.     stopDelete := TRUE;
  551.   END;
  552. END createNewFiles;
  553.  
  554. PROCEDURE deleteNewFiles ();
  555.  VAR datName,
  556.       tabName,
  557.       parName : ARRAY [0..255] OF CHAR;
  558.       gName   : ARRAY [0..255] OF CHAR;
  559.       res     : INTEGER;
  560. BEGIN
  561.   buildName (currentGroup, gName);
  562.   Strings.Concat (PutzTypes.tmpPath, gName, datName, v.bool);
  563.   Strings.Assign (datName, parName, v.bool);
  564.   Strings.Assign (datName, tabName, v.bool);
  565.   Strings.Append ('.pa', parName, v.bool);
  566.   Strings.Append ('.da', datName, v.bool);
  567.   Strings.Append ('.ta', tabName, v.bool);
  568.   v.bool := MagicDOS.Fdelete (parName);
  569.   v.bool := MagicDOS.Fdelete (tabName);
  570.   v.bool := MagicDOS.Fdelete (datName);
  571. END deleteNewFiles;
  572.  
  573. PROCEDURE move (REF from, to : ARRAY OF CHAR; res :INTEGER);
  574.   VAR s, d : fileHandle;
  575.       mbuf : ADDRESS;
  576.       slen : LONGCARD;
  577.       blen : LONGCARD;
  578.       pos  : LONGCARD;
  579.       readB: LONGCARD;
  580.  
  581.   PROCEDURE closeIt();
  582.   BEGIN
  583.     v.bool := MFree (mbuf);
  584.     v.int := MagicDOS.Fclose (d);
  585.     v.int := MagicDOS.Fclose (s);
  586.   END closeIt;
  587.   
  588. BEGIN
  589.   OpenFile (s, from);
  590.   CreateFile (d, to);
  591.   slen := FileSize (s);
  592.   blen := MemAvail();
  593.   IF blen < 12000 THEN RETURN END;
  594.   blen := blen - 8192;
  595.   mbuf := MagicDOS.Malloc ( blen);
  596.   IF mbuf = NIL THEN RETURN END;
  597.   pos := 0L;
  598.   WHILE pos + blen <= slen DO
  599.     ReadBytes (s, mbuf, blen, readB);
  600.     IF stopDelete
  601.     THEN
  602.       closeIt;
  603.       RETURN
  604.     END;
  605.     WriteBytes (d, mbuf, blen);
  606.     IF stopDelete
  607.     THEN
  608.       closeIt;
  609.       RETURN
  610.     END;
  611.     INC (pos, blen);
  612.   END;
  613.   IF pos < slen THEN
  614.     ReadBytes (s, mbuf, slen-pos, readB);
  615.     IF stopDelete
  616.     THEN
  617.       closeIt;
  618.       RETURN
  619.     END;
  620.     WriteBytes (d, mbuf, slen-pos);
  621.     IF stopDelete
  622.     THEN
  623.       closeIt;
  624.       RETURN
  625.     END;
  626.   END;
  627.   closeIt;
  628.   v.bool := MagicDOS.Fdelete (from);
  629. END move;
  630.  
  631. PROCEDURE makeNewNames ();
  632.  VAR  ndatName,
  633.       ntabName,
  634.       nparName,
  635.       datName,
  636.       tabName,
  637.       parName : ARRAY [0..255] OF CHAR;
  638.       gName   : ARRAY [0..255] OF CHAR;
  639.       res     : INTEGER;
  640. BEGIN
  641.   buildName (currentGroup, gName);
  642.   Strings.Concat (MTPaths.DataPath, gName, datName, v.bool);
  643.   Strings.Assign (datName, parName, v.bool);
  644.   Strings.Assign (datName, tabName, v.bool);
  645.   Strings.Concat (PutzTypes.tmpPath, gName, ndatName, v.bool);
  646.   Strings.Assign (ndatName, nparName, v.bool);
  647.   Strings.Assign (ndatName, ntabName, v.bool);
  648.   Strings.Append ('.par', parName, v.bool);
  649.   Strings.Append ('.dat', datName, v.bool);
  650.   Strings.Append ('.tab', tabName, v.bool);
  651.   Strings.Append ('.pa', nparName, v.bool);
  652.   Strings.Append ('.da', ndatName, v.bool);
  653.   Strings.Append ('.ta', ntabName, v.bool);
  654.   v.bool := MagicDOS.Fdelete (parName);
  655.   v.bool := MagicDOS.Fdelete (datName);
  656.   v.bool := MagicDOS.Fdelete (tabName);
  657.   res := MagicDOS.Frename (nparName, parName);
  658.   IF res # 0
  659.   THEN
  660.     move (ndatName, datName, res);
  661.     move (nparName, parName, res);
  662.     move (ntabName, tabName, res);
  663.   ELSE
  664.     res := MagicDOS.Frename (ndatName, datName);
  665.     res := MagicDOS.Frename (ntabName, tabName);
  666.   END;
  667. END makeNewNames;
  668.  
  669. PROCEDURE openNewPar();
  670.   VAR parName : ARRAY [0..255] OF CHAR;
  671.       gName   : ARRAY [0..255] OF CHAR;
  672. BEGIN
  673.   buildName (currentGroup, gName);
  674.   Strings.Concat (PutzTypes.tmpPath, gName, parName, v.bool);
  675.   Strings.Append ('.PA',parName, v.bool);
  676.   OpenFile (newPar, parName);
  677. END openNewPar;
  678.  
  679. PROCEDURE BufferTabAndPar();
  680.   VAR tabSize, parSize : LONGCARD;
  681.       memS : LONGCARD;
  682. BEGIN
  683.   (* zuerst PAR buffern *)
  684.   parArray := NIL;
  685.   newParArray := NIL;
  686.   tabArray := NIL;
  687.   newTabArray := NIL;
  688.   parSize := FileSize (parFile);
  689.   IF parSize > 1
  690.   THEN
  691.     AnzMessages := SHORT((parSize - dataSys.dbHeaderLength) DIV TSIZE(dataSys.pBlock));
  692.   ELSE
  693.     AnzMessages := 0;
  694.   END;
  695.   memS := MemAvail();
  696.   IF (memS < 8192) OR (memS-8192L < 2L*parSize)
  697.   THEN
  698.     parBuffered := FALSE;
  699.     tabBuffered := FALSE;
  700.     RETURN
  701.   END;
  702.   parArray := MagicDOS.Malloc (parSize);
  703.   newParArray := MagicDOS.Malloc (parSize);
  704.   IF (parArray= NIL) OR (newParArray = NIL)
  705.   THEN
  706.     IF parArray # NIL THEN v.bool := MFree (parArray) END;
  707.     IF newParArray # NIL THEN v.bool := MFree (newParArray) END;
  708.     parBuffered := FALSE;
  709.     tabBuffered := FALSE;
  710.     RETURN
  711.   END;
  712.   ReadBytes (parFile, parArray, parSize, bRead);
  713.   IF bRead = parSize 
  714.   THEN 
  715.     parBuffered := TRUE;
  716.     newParArray^.dbHeader := parArray^.dbHeader;
  717.   ELSE
  718.     parBuffered := FALSE;
  719.     tabBuffered := FALSE;
  720.     IF parArray # NIL THEN v.bool := MFree (parArray) END;
  721.     IF newParArray # NIL THEN v.bool := MFree (newParArray) END;
  722.   END;
  723.   (* jetzt TAB puffern *)
  724.   tabSize := FileSize (tabFile);
  725.   memS := MemAvail();
  726.   IF (memS < 8192) OR (memS-8192L < 2L*tabSize)    (* 2-mal fr alt- und neu *)
  727.   THEN
  728.     tabBuffered := FALSE;
  729.     RETURN
  730.   END;
  731.   tabArray := MagicDOS.Malloc (tabSize);
  732.   newTabArray := MagicDOS.Malloc (tabSize);
  733.   IF (tabArray = NIL) OR (newTabArray = NIL)
  734.   THEN
  735.     IF tabArray # NIL THEN v.bool := MFree (tabArray) END;
  736.     IF newTabArray # NIL THEN v.bool := MFree (newTabArray) END;
  737.     tabBuffered := FALSE;
  738.     RETURN
  739.   END;
  740.   ReadBytes (tabFile, tabArray, tabSize, bRead);
  741.   IF bRead = tabSize THEN tabBuffered := TRUE
  742.   ELSE tabBuffered := FALSE;
  743.     IF tabArray # NIL THEN v.bool := MFree (tabArray) END;
  744.     IF newTabArray # NIL THEN v.bool := MFree (newTabArray) END;
  745.   END;
  746. END BufferTabAndPar;
  747.  
  748. PROCEDURE BufferDatFile();
  749.  VAR memS : LONGCARD;
  750. BEGIN
  751.   (* zuerst TAB buffern *)
  752.   datSize := FileSize (datFile);
  753.   datBuffer := NIL;
  754.   memS := MemAvail();
  755.   IF (memS < 8192) OR (memS-8192L < datSize)
  756.   THEN
  757.     datBuffered := FALSE;
  758.     RETURN
  759.   END;
  760.   datBuffer := MagicDOS.Malloc (datSize);
  761.   IF datBuffer = NIL
  762.   THEN
  763.     datBuffered := FALSE;
  764.     RETURN
  765.   END;
  766.   ReadBytes (datFile, datBuffer, datSize, bRead);
  767.   IF bRead = datSize THEN datBuffered := TRUE
  768.   ELSE datBuffered := FALSE; v.bool := MFree (datBuffer); END;
  769. END BufferDatFile;
  770.  
  771. PROCEDURE killBuffer();
  772. BEGIN
  773.   IF datBuffer # NIL THEN v.bool := MFree (datBuffer) END;
  774.   IF newTabArray # NIL THEN v.bool := MFree (newTabArray); END;
  775.   IF tabArray # NIL THEN v.bool := MFree (tabArray); END;
  776.   IF newParArray # NIL THEN v.bool := MFree (newParArray); END;
  777.   IF parArray # NIL THEN v.bool := MFree (parArray); END;
  778. END killBuffer;
  779.  
  780. PROCEDURE GetParam (pFile : fileHandle; index : CARDINAL;
  781.                     parArray : PutzTypes.parFilePtr; VAR param: dataSys.pBlock);
  782. BEGIN
  783.   IF parBuffered
  784.   THEN
  785.     param := parArray^.params[index]
  786.   ELSE
  787.     v.lcard := MagicDOS.Fseek (dataSys.dbHeaderLength+LONG(index)*TSIZE(dataSys.pBlock), pFile, MagicDOS.SeekStart);
  788.     ReadBytes (pFile, ADR(param), TSIZE (dataSys.pBlock), v.lcard);
  789.   END;
  790. END GetParam;
  791.  
  792. PROCEDURE PutParam (pFile : fileHandle; index : CARDINAL;
  793.                     parArray : PutzTypes.parFilePtr; VAR param : dataSys.pBlock);
  794. BEGIN
  795.   param.crc := ZCalcCrc.CalcCrcArray(ADR(param)+ADDRESS(2), SHORT(TSIZE(dataSys.pBlock))-2);
  796.   IF parBuffered
  797.   THEN
  798.     parArray^.params[index] := param;
  799.   ELSE
  800.     v.lcard := MagicDOS.Fseek (dataSys.dbHeaderLength+LONG(index)*TSIZE(dataSys.pBlock), pFile, MagicDOS.SeekStart);
  801.     WriteBytes (pFile, ADR(param), TSIZE(dataSys.pBlock));
  802.   END;
  803. END PutParam;
  804.  
  805. PROCEDURE CheckLongDate (date : LONGCARD) : BOOLEAN;
  806. (* Cat-Datum in ein menschenlesbares verwandeln *)
  807. VAR c1, year, y,m,d : CARDINAL;
  808. BEGIN
  809. (* Jahr *)
  810.   year:= SHORT(date DIV    100000000);
  811.   date:= date MOD          100000000;
  812.   INC(year, 1990);
  813.   (* Jetzt ist das Jahr bestimmt. *) 
  814.   IF (year < 1980) 
  815.   THEN 
  816.     RETURN FALSE
  817.   END;
  818.   y := year;
  819. (* Monat *)
  820.   c1  := SHORT(date DIV     10000000);
  821.   m   := c1 * 10;
  822.   date:= date MOD           10000000;
  823.   c1  := SHORT(date DIV      1000000);
  824.   m   := m + c1;
  825.   IF (m < 1) OR (m > 12) THEN RETURN FALSE END;
  826.   date:= date MOD            1000000;
  827. (* Tag *)
  828.   c1  := SHORT(date DIV       100000);
  829.   d   := c1 * 10;
  830.   date:= date MOD             100000;
  831.   c1  := SHORT(date DIV        10000);
  832.   d   := d + c1;
  833.   IF (d < 1) OR (d > 31) THEN RETURN FALSE END;
  834.   date:= date MOD              10000;
  835. (* Stunde *)
  836.   c1  := SHORT(date DIV         1000);
  837.   date:= date MOD               1000;
  838.   m := c1; 
  839.   c1  := SHORT(date DIV          100);
  840.   m := m*10 + c1;               (* Stunde *)
  841.   IF m > 23 THEN RETURN FALSE END;
  842.   
  843.   date:= date MOD                100;
  844. (* Minute *)
  845.   c1  := SHORT(date DIV           10);
  846.   date:= date MOD                 10;
  847.   m := c1*10 + SHORT(date);
  848.   IF m > 59 THEN RETURN FALSE END;
  849.   RETURN TRUE;
  850. END CheckLongDate;
  851.  
  852. PROCEDURE IsMessOk (VAR param: dataSys.pBlock): BOOLEAN;
  853. BEGIN
  854.   RETURN (param.Start < datSize) & 
  855.          (param.hLength < 4096) & 
  856.          (param.idLength < 1024) & 
  857.          (param.Start+LONG(param.hLength)+LONG(param.Length) <= datSize) & 
  858.           CheckLongDate (param.Datum);
  859. END IsMessOk;
  860.  
  861. PROCEDURE deleteByFlags (VAR param : dataSys.pBlock; idx: CARDINAL; pass: INTEGER) : delState;
  862.   VAR pInfo : dataSys.pInfoType; 
  863.       br    : LONGCARD;
  864. BEGIN
  865.   WITH putzOpts DO
  866.     (* Erst mal auf gltige Werte prfen *)
  867.     IF IsMessOk (param)
  868.     THEN 
  869.       (* Hier muž jetzt nur bei der privaten Gruppe auch noch das 
  870.        * Statusdatum geprft werden
  871.        *)
  872.       IF currentGroup = dataSys.private
  873.       THEN
  874.         GetDat (datFile, param.Start+LONG(param.hLength) - TSIZE (dataSys.pInfoType), ADR(pInfo), TSIZE(dataSys.pInfoType), br);
  875.         IF ~CheckLongDate (pInfo.LeseDatum)
  876.         THEN
  877.           RETURN badMess
  878.         END;
  879.         IF (pInfo.Status = 'Z') OR (pInfo.Status = 'N')
  880.         THEN
  881.           IF dataSys.bTotalloeschung IN param.bits
  882.           THEN RETURN totalDel
  883.           ELSIF dataSys.bTeilloeschung IN param.bits
  884.           THEN
  885.             IF (param.KomCount = 0) & delWithoutComm
  886.             THEN
  887.               RETURN totalDel
  888.             ELSE
  889.               RETURN partDel
  890.             END;
  891.           END;
  892.           RETURN noDel;
  893.         END;
  894.       END;
  895.       IF ((intFlag = noDel) & (dataSys.bInteressant IN param.bits)) OR
  896.          ((usrFlg1 = noDel) & (dataSys.bUser1 IN param.bits) ) OR
  897.          ((usrFlg2 = noDel) & (dataSys.bUser2 IN param.bits) ) OR
  898.          ((filtFlg = noDel) & (dataSys.bFiltered IN param.bits) ) OR
  899.          ((readFlg = noDel) & (dataSys.bGelesen IN param.bits) )
  900.       THEN
  901.         RETURN noDel
  902.       END;
  903.       IF dataSys.bTotalloeschung IN param.bits
  904.       THEN RETURN totalDel
  905.       ELSIF dataSys.bTeilloeschung IN param.bits
  906.       THEN
  907.         IF (param.KomCount = 0) & delWithoutComm
  908.         THEN
  909.           RETURN totalDel
  910.         ELSE
  911.           RETURN partDel
  912.         END;
  913.       END;
  914.       IF deleteByDate & (param.Datum > delDate)
  915.       THEN
  916.         RETURN noDel
  917.       END;
  918.       IF ((intFlag = totalDel) & (dataSys.bInteressant IN param.bits)) OR
  919.          ((usrFlg1 = totalDel) & (dataSys.bUser1 IN param.bits) ) OR
  920.          ((usrFlg2 = totalDel) & (dataSys.bUser2 IN param.bits) ) OR
  921.          ((filtFlg = totalDel) & (dataSys.bFiltered IN param.bits) ) OR
  922.          ((readFlg = totalDel) & (dataSys.bGelesen IN param.bits) )
  923.       THEN
  924.         RETURN totalDel
  925.       END;
  926.       IF ((intFlag = partDel) & (dataSys.bInteressant IN param.bits)) OR
  927.          ((usrFlg1 = partDel) & (dataSys.bUser1 IN param.bits) ) OR
  928.          ((usrFlg2 = partDel) & (dataSys.bUser2 IN param.bits) ) OR
  929.          ((filtFlg = partDel) & (dataSys.bFiltered IN param.bits) ) OR
  930.          ((readFlg = partDel) & (dataSys.bGelesen IN param.bits) )
  931.       THEN
  932.         IF (param.KomCount = 0)
  933.         THEN
  934.           RETURN totalDel
  935.         ELSE
  936.           RETURN partDel
  937.         END;
  938.       END;
  939.     ELSE
  940.       RETURN badMess
  941.     END;
  942.   END;
  943.   IF (putzOpts.noRdFlg # ignoreFlag) & ~(dataSys.bGelesen IN param.bits)
  944.   THEN
  945.     RETURN putzOpts.noRdFlg
  946.   END;
  947.   RETURN noDel
  948. END deleteByFlags;
  949.  
  950. PROCEDURE deleteDate (VAR param : dataSys.pBlock; idx: CARDINAL; pass: INTEGER) : delState;
  951.   VAR pInfo : dataSys.pInfoType; 
  952.       br    : LONGCARD;
  953. BEGIN
  954.   WITH putzOpts DO
  955.     (* Erst mal auf gltige Werte prfen *)
  956.     IF IsMessOk (param)
  957.     THEN 
  958.       (* Hier muž jetzt nur bei der privaten Gruppe auch noch das 
  959.        * Statusdatum geprft werden
  960.        *)
  961.       IF currentGroup = dataSys.private
  962.       THEN
  963.         GetDat (datFile, param.Start+LONG(param.hLength) - TSIZE (dataSys.pInfoType), ADR(pInfo), TSIZE(dataSys.pInfoType), br);
  964.         IF ~CheckLongDate (pInfo.LeseDatum)
  965.         THEN
  966.           RETURN badMess
  967.         END;
  968.         IF (pInfo.Status = 'Z') OR (pInfo.Status = 'N')
  969.         THEN
  970.           IF dataSys.bTotalloeschung IN param.bits
  971.           THEN RETURN totalDel
  972.           ELSIF dataSys.bTeilloeschung IN param.bits
  973.           THEN
  974.             IF (param.KomCount = 0) & delWithoutComm
  975.             THEN
  976.               RETURN totalDel
  977.             ELSE
  978.               RETURN partDel
  979.             END;
  980.           END;
  981.           RETURN noDel;
  982.         END;
  983.       END;
  984.       IF deleteByDate & (param.Datum > delDate)
  985.       THEN
  986.         RETURN noDel
  987.       END;
  988.       IF (dataSys.bInteressant IN param.bits)
  989.       THEN
  990.         RETURN noDel
  991.       END;
  992.       RETURN totalDel
  993.     ELSE
  994.       RETURN badMess;
  995.     END;
  996.   END;
  997. END deleteDate;
  998.  
  999. VAR newAnz,
  1000.     minIdx  : CARDINAL;
  1001.  
  1002. PROCEDURE deleteDateAndNum (VAR param : dataSys.pBlock; idx: CARDINAL; pass: INTEGER) : delState;
  1003.   VAR pInfo : dataSys.pInfoType; 
  1004.       br    : LONGCARD;
  1005.       res   : delState;
  1006. BEGIN
  1007.   WITH putzOpts DO
  1008.     (* Erst mal auf gltige Werte prfen *)
  1009.     IF IsMessOk (param)
  1010.     THEN 
  1011.       (* Hier muž jetzt nur bei der privaten Gruppe auch noch das 
  1012.        * Statusdatum geprft werden
  1013.        *)
  1014.       IF currentGroup = dataSys.private
  1015.       THEN
  1016.         GetDat (datFile, param.Start+LONG(param.hLength) - TSIZE (dataSys.pInfoType), ADR(pInfo), TSIZE(dataSys.pInfoType), br);
  1017.         IF ~CheckLongDate (pInfo.LeseDatum)
  1018.         THEN
  1019.           RETURN badMess
  1020.         END;
  1021.         IF (pInfo.Status = 'Z') OR (pInfo.Status = 'N')
  1022.         THEN
  1023.           IF dataSys.bTotalloeschung IN param.bits
  1024.           THEN RETURN totalDel
  1025.           ELSIF dataSys.bTeilloeschung IN param.bits
  1026.           THEN
  1027.             IF (param.KomCount = 0) & delWithoutComm
  1028.             THEN
  1029.               RETURN totalDel
  1030.             ELSE
  1031.               RETURN partDel
  1032.             END;
  1033.           END;
  1034.           RETURN noDel;
  1035.         END;
  1036.       END;
  1037.       IF pass = 1
  1038.       THEN
  1039.         IF (param.Datum > delDate)
  1040.         THEN
  1041.           IF newAnz >= number
  1042.           THEN
  1043.             res := totalDel
  1044.           ELSE
  1045.             INC (newAnz);
  1046.             res := noDel
  1047.           END;
  1048.         ELSE
  1049.           res := totalDel
  1050.         END;
  1051.         IF (res = noDel)
  1052.         THEN
  1053.           minIdx := idx;
  1054.         END;
  1055.       ELSE (* pass > 1 *)
  1056.         IF idx >= minIdx
  1057.         THEN
  1058.           IF (param.Datum > delDate)
  1059.           THEN
  1060.             RETURN noDel
  1061.           ELSE
  1062.             IF (dataSys.bInteressant IN param.bits)
  1063.             THEN
  1064.               RETURN noDel
  1065.             END;
  1066.             RETURN totalDel
  1067.           END;
  1068.         ELSE
  1069.           IF (dataSys.bInteressant IN param.bits)
  1070.           THEN
  1071.             RETURN noDel
  1072.           END;
  1073.           RETURN totalDel
  1074.         END;
  1075.       END;
  1076.     ELSE
  1077.       RETURN badMess;
  1078.     END;
  1079.   END;
  1080. END deleteDateAndNum;
  1081.  
  1082. PROCEDURE deleteNum (VAR param : dataSys.pBlock; idx: CARDINAL; pass: INTEGER) : delState;
  1083.   VAR pInfo : dataSys.pInfoType; 
  1084.       br    : LONGCARD;
  1085.       res   : delState;
  1086. BEGIN
  1087.   WITH putzOpts DO
  1088.     (* Erst mal auf gltige Werte prfen *)
  1089.     IF IsMessOk (param)
  1090.     THEN 
  1091.       (* Hier muž jetzt nur bei der privaten Gruppe auch noch das 
  1092.        * Statusdatum geprft werden
  1093.        *)
  1094.       IF currentGroup = dataSys.private
  1095.       THEN
  1096.         GetDat (datFile, param.Start+LONG(param.hLength) - TSIZE (dataSys.pInfoType), ADR(pInfo), TSIZE(dataSys.pInfoType), br);
  1097.         IF ~CheckLongDate (pInfo.LeseDatum)
  1098.         THEN
  1099.           RETURN badMess
  1100.         END;
  1101.         IF (pInfo.Status = 'Z') OR (pInfo.Status = 'N')
  1102.         THEN
  1103.           IF dataSys.bTotalloeschung IN param.bits
  1104.           THEN RETURN totalDel
  1105.           ELSIF dataSys.bTeilloeschung IN param.bits
  1106.           THEN
  1107.             IF (param.KomCount = 0) & delWithoutComm
  1108.             THEN
  1109.               RETURN totalDel
  1110.             ELSE
  1111.               RETURN partDel
  1112.             END;
  1113.           END;
  1114.           RETURN noDel;
  1115.         END;
  1116.       END;
  1117.       IF pass = 1
  1118.       THEN
  1119.         IF newAnz >= number
  1120.         THEN
  1121.           res := totalDel
  1122.         ELSE
  1123.           INC (newAnz);
  1124.           res := noDel
  1125.         END;
  1126.         IF (res = noDel)
  1127.         THEN
  1128.           minIdx := idx;
  1129.         END;
  1130.       ELSE (* pass > 1 *)
  1131.         IF idx >= minIdx
  1132.         THEN
  1133.           RETURN noDel
  1134.         ELSE
  1135.           IF (dataSys.bInteressant IN param.bits)
  1136.           THEN
  1137.             RETURN noDel
  1138.           END;
  1139.           RETURN totalDel
  1140.         END;
  1141.       END;
  1142.     ELSE
  1143.       RETURN badMess;
  1144.     END;
  1145.   END;
  1146. END deleteNum;
  1147.  
  1148. VAR shouldBeDeleted : PutzTypes.deleteProc;
  1149.  
  1150. PROCEDURE doDelete(): INTEGER;
  1151.   VAR i : CARDINAL;
  1152.       dState : delState;
  1153.       param : dataSys.pBlock;
  1154.       pass  : INTEGER;
  1155.       doPass2 : BOOLEAN;
  1156.       
  1157. BEGIN
  1158.   doPass2 := FALSE;
  1159.   pass := 0;
  1160.   IF (putzOpts.dMode = PutzTypes.dNum) OR (putzOpts.dMode = PutzTypes.dDateAndNum)
  1161.   THEN
  1162.     (* First pass! *)
  1163.     pass := 1;
  1164.     newAnz := 0;
  1165.     minIdx := AnzMessages;
  1166.     FOR i := AnzMessages-1 TO 0 BY -1 DO 
  1167.       GetParam (parFile, i, parArray, param);
  1168.       IF ~PutzAction.TellAction (4, AnzMessages-i) THEN stopDelete := TRUE; RETURN 0 END;
  1169.       dState := shouldBeDeleted (param, i, pass);
  1170.       IF dState = badMess
  1171.       THEN
  1172.         doPass2 := TRUE;
  1173.       END;
  1174.     END;
  1175.     PutzLog.putTime();
  1176.     PutzLog.WriteString ('Pass 1 beendet');
  1177.     PutzLog.WriteLn;
  1178.     IF (putzOpts.dMode = PutzTypes.dNum) & ~doPass2
  1179.     THEN
  1180.       IF putzOpts.number >= AnzMessages -1 THEN 
  1181.         PutzLog.putTime();
  1182.         PutzLog.WriteString ('Pass 2 wird nicht ben”tigt, nichts zu l”schen');
  1183.         PutzLog.WriteLn;
  1184.         RETURN 1
  1185.       END;
  1186.     END;
  1187.   ELSE
  1188.     PutzLog.putTime();
  1189.     PutzLog.WriteString ('Pass 1 wird nicht ben”tigt, bersprungen');
  1190.     PutzLog.WriteLn;
  1191.   END;
  1192.   INC (pass);
  1193.   PutzAction.BeginNextPass(1);
  1194.   FOR i := 0 TO AnzMessages-1 DO
  1195.     GetParam (parFile, i, parArray, param);
  1196.     IF ~PutzAction.TellAction (1, i+1) THEN stopDelete := TRUE; RETURN 0 END;
  1197.     IF (i = AnzMessages-1) & (msgCounter = 0)
  1198.     THEN
  1199.       dState := noDel
  1200.     ELSE
  1201.       dState := shouldBeDeleted (param, i, pass);
  1202.     END;
  1203.     CASE dState OF
  1204.       partDel : partDelete (i, param); |
  1205.       noDel   : noDelete (i, param); |
  1206.       totalDel: totalDelete (i, param); |
  1207.       badMess : badDelete (i, param); |
  1208.     ELSE
  1209.     END;
  1210.     IF stopDelete THEN RETURN 0 END;
  1211.     (*
  1212.     PutParam (parFile, i, parArray, param);
  1213.     *)
  1214.   END;
  1215.   PutzLog.putTime();
  1216.   PutzLog.WriteString ('Pass 2 beendet');
  1217.   PutzLog.WriteLn;
  1218.   RETURN 0
  1219. END doDelete;
  1220.  
  1221. PROCEDURE FlushParam(pFile : fileHandle; addr : ADDRESS);
  1222. BEGIN
  1223.   IF parBuffered
  1224.   THEN
  1225.     v.lcard := MagicDOS.Fseek (0L, pFile, MagicDOS.SeekStart);
  1226.     WriteBytes (pFile, addr, dataSys.dbHeaderLength + (LONG(msgCounter)*TSIZE(dataSys.pBlock)));
  1227.   END;
  1228. END FlushParam;
  1229.  
  1230. PROCEDURE FlushTab (pFile : fileHandle; addr : ADDRESS);
  1231. BEGIN
  1232.   IF tabBuffered
  1233.   THEN
  1234.     v.lcard := MagicDOS.Fseek (0L, pFile, MagicDOS.SeekStart);
  1235.     WriteBytes (pFile, addr,
  1236.                        LONG(msgCounter)*TSIZE(CARDINAL));
  1237.   END;
  1238. END FlushTab;
  1239.  
  1240. PROCEDURE bufferNewPar;
  1241.   VAR parSize : LONGCARD;
  1242.       memS : LONGCARD;
  1243. BEGIN
  1244.   AnzMessages := msgCounter;
  1245.   parSize := (LONG(AnzMessages) * TSIZE (dataSys.pBlock)) + dataSys.dbHeaderLength;
  1246.   IF parBuffered
  1247.   THEN
  1248.     Block.Copy (newParArray, parSize, parArray);
  1249.     v.bool := MFree (newParArray);
  1250.   ELSE
  1251.     parArray := NIL;
  1252.     memS := MemAvail();
  1253.     IF (memS < 8192) OR (memS-8192L < parSize)
  1254.     THEN
  1255.       parBuffered := FALSE;
  1256.       RETURN
  1257.     END;
  1258.     parArray := MagicDOS.Malloc (parSize);
  1259.     IF parArray = NIL
  1260.     THEN
  1261.       parBuffered := FALSE;
  1262.       RETURN
  1263.     END;
  1264.     v.lcard := MagicDOS.Fseek (0L, newPar, MagicDOS.SeekStart);
  1265.     ReadBytes (newPar, parArray, parSize, bRead);
  1266.     IF bRead = parSize THEN parBuffered := TRUE
  1267.     ELSE parBuffered := FALSE; v.bool := MFree (parArray); END;
  1268.   END;
  1269. END bufferNewPar;
  1270.  
  1271. PROCEDURE buildNewRight(pFile : fileHandle; index, comment : CARDINAL;
  1272.                        parArray : PutzTypes.parFilePtr) : CARDINAL;
  1273.   VAR param, pdown : dataSys.pBlock;
  1274.       run          : CARDINAL;
  1275. BEGIN
  1276.   GetParam (pFile, index, parArray, param);
  1277.   run := param.downMess;
  1278.   IF run = comment THEN RETURN dataSys.empty END;
  1279.   LOOP
  1280.     GetParam (pFile, run, parArray, pdown);
  1281.     IF pdown.rightMess = comment THEN RETURN run END;
  1282.     IF (pdown.rightMess = dataSys.empty) OR (pdown.rightMess = dataSys.notSaved)
  1283.     THEN
  1284.       pdown.rightMess := comment;
  1285.       PutParam (pFile, run, parArray, pdown);
  1286.       RETURN run
  1287.     ELSE
  1288.       run := pdown.rightMess;
  1289.     END;
  1290.   END;
  1291. END buildNewRight;
  1292.  
  1293. PROCEDURE IncCommCount(pFile : fileHandle; index, comment : CARDINAL;
  1294.                        parArray : PutzTypes.parFilePtr);
  1295.   VAR param : dataSys.pBlock;
  1296. BEGIN
  1297.   GetParam (pFile, index, parArray, param);
  1298.   INC (param.KomCount);
  1299.   IF param.KomCount = 1
  1300.   THEN
  1301.     param.downMess := comment;
  1302.     IF param.downMess = dataSys.notSaved THEN
  1303.       param.downMess := dataSys.empty; param.KomCount := 0
  1304.     END;
  1305.   END;
  1306.   PutParam (pFile, index, parArray, param);
  1307. END IncCommCount;
  1308.  
  1309. PROCEDURE linkNewPar;
  1310.   VAR i : CARDINAL;
  1311.       param : dataSys.pBlock;
  1312.       par2  : dataSys.pBlock;
  1313.       par3  : dataSys.pBlock;
  1314.       par2Idx: CARDINAL;
  1315.  
  1316.   PROCEDURE makeNewLinks();
  1317.     VAR i : CARDINAL;
  1318.   BEGIN
  1319.     FOR i := 0 TO AnzMessages-1 DO
  1320.       GetParam (newPar, i, parArray, param);
  1321.       WITH param DO
  1322.       (*
  1323.         IF currentGroup # dataSys.private
  1324.         THEN
  1325.       *)
  1326.         (* Kommentare bearbeiten *)
  1327.         IF (upMess < dataSys.notSaved)
  1328.         THEN
  1329.           upMess := newNums[upMess];
  1330.           IF (upMess # dataSys.notSaved) & (upMess >= i) THEN upMess := dataSys.notSaved END;
  1331.           IF (upMess < dataSys.notSaved) & (upMess < AnzMessages)
  1332.           THEN
  1333.             IncCommCount (newPar, upMess, i, parArray);
  1334.           END;
  1335.         END;
  1336.         IF (downMess < dataSys.notSaved)
  1337.         THEN
  1338.           downMess := newNums[downMess];
  1339.           IF (downMess # dataSys.notSaved) & ((downMess <= i) OR (downMess >= AnzMessages)) THEN downMess := dataSys.notSaved END;
  1340.         END;
  1341.         IF (downMess = dataSys.notSaved) OR (downMess > AnzMessages) THEN downMess := dataSys.empty; KomCount := 0 END;
  1342.         IF (rightMess < dataSys.notSaved)
  1343.         THEN
  1344.           rightMess := newNums[rightMess];
  1345.           IF (rightMess # dataSys.notSaved) & ((rightMess >= i) OR (rightMess >= AnzMessages)) THEN rightMess := dataSys.notSaved END;
  1346.         END;
  1347.         IF rightMess = dataSys.notSaved THEN rightMess := dataSys.empty END;
  1348.         IF leftMess < dataSys.notSaved
  1349.         THEN
  1350.           leftMess := newNums[leftMess];
  1351.           IF (leftMess # dataSys.notSaved) & ((leftMess <= i) OR (leftMess >= AnzMessages)) THEN leftMess := dataSys.notSaved END;
  1352.           IF (leftMess = dataSys.notSaved) & (upMess < dataSys.notSaved) & (upMess < AnzMessages)
  1353.           THEN
  1354.             leftMess := buildNewRight (newPar, upMess, i, parArray);
  1355.           END;
  1356.         END;
  1357.         IF (leftMess = dataSys.notSaved) OR (leftMess >= AnzMessages) THEN leftMess := dataSys.empty END;
  1358.         (*
  1359.         ELSE
  1360.           IF Question < dataSys.notSaved
  1361.           THEN
  1362.             Question := newNums[Question];
  1363.             IF (Question # dataSys.notSaved) & (Question >=i) THEN Question := dataSys.notSaved END;
  1364.           END;
  1365.           IF Answer < dataSys.notSaved
  1366.           THEN
  1367.             Answer := newNums[Answer];
  1368.             IF (Answer # dataSys.notSaved) & (Answer <= i) THEN Answer := dataSys.notSaved END;
  1369.           END;
  1370.           IF Answer = dataSys.notSaved THEN Answer := dataSys.empty END;
  1371.         END;
  1372.         *)
  1373.       END (* with param *);
  1374.       PutParam (newPar, i, parArray, param);
  1375.     END (* FOR i *);
  1376.   END makeNewLinks;
  1377.   
  1378.   PROCEDURE checkLinks();
  1379.     VAR i : CARDINAL;
  1380.   BEGIN
  1381.     FOR i := 0 TO AnzMessages-1 DO
  1382.       GetParam (newPar, i, parArray, param);
  1383.       WITH param DO
  1384.         KomCount := 0;  (* Wird gleich wieder neu aufgebaut! *)
  1385.         (* Check down messages and correct errors *)
  1386.         IF downMess < dataSys.notSaved
  1387.         THEN
  1388.           GetParam (newPar, downMess, parArray, par2);
  1389.           IF par2.upMess # i
  1390.           THEN
  1391.             (* Error in ParBlock! *)
  1392.             par2.upMess := i;
  1393.             PutParam (newPar, downMess, parArray, par2);
  1394.           END;
  1395.           par2Idx := downMess;
  1396.           WHILE par2.rightMess < dataSys.notSaved DO
  1397.             GetParam (newPar, par2.rightMess, parArray, par3);
  1398.             IF par3.upMess # i
  1399.             THEN
  1400.               (* Error in ParBlock! *)
  1401.               par3.upMess := i;
  1402.               PutParam (newPar, downMess, parArray, par3);
  1403.             END;
  1404.             (* Check left-right *)
  1405.             IF par3.leftMess # par2Idx
  1406.             THEN
  1407.               (* Error in ParBlock! *)
  1408.               par3.leftMess := par2Idx;
  1409.               PutParam (newPar, downMess, parArray, par3);
  1410.             END;
  1411.             par2Idx := par2.rightMess;
  1412.             par2 := par3;
  1413.           END;
  1414.         END;
  1415.         IF (upMess < dataSys.notSaved) & (upMess < AnzMessages)
  1416.         THEN
  1417.           IncCommCount (newPar, upMess, i, parArray);
  1418.         END;
  1419.       END;
  1420.       PutParam (newPar, i, parArray, param);
  1421.     END;
  1422.   END checkLinks;
  1423.  
  1424. BEGIN
  1425.   openNewPar();
  1426.   bufferNewPar;
  1427.   IF AnzMessages > 0 THEN
  1428.     (* Neue Verkettung aufbauen *)
  1429.     makeNewLinks();
  1430.     (* So, und jetzt noch mal alles berprfen *)
  1431.     checkLinks ();
  1432.   END;
  1433.   IF parBuffered THEN FlushParam(newPar, parArray); v.bool := MFree (parArray); END;
  1434. END linkNewPar;
  1435.  
  1436. (*
  1437. TYPE posType   = (aktuellePos, neuePos, letztePos, unreadPos, unreadCount);
  1438. TYPE PositionType = (actualPos, newPos, lastPos);
  1439.  
  1440. *)
  1441. CONST maxGroup  = 255;
  1442.  
  1443. TYPE  GrArray    = ARRAY[0..maxGroup] OF dataSys.onePos;
  1444.  
  1445.       GrPosType  = RECORD
  1446.                      hdr : dataSys.FileHeaderType;
  1447.                      pos : GrArray;
  1448.                    END;
  1449.  
  1450.  
  1451. VAR grPos : GrPosType;
  1452.     newPos: dataSys.grPosType;
  1453.  
  1454. PROCEDURE CreatePosArray (used: CARDINAL): BOOLEAN;
  1455.   VAR i : CARDINAL;
  1456.       z : dataSys.posType;
  1457. BEGIN
  1458.   newPos.usedGroups := used;
  1459.   newPos.posGroups := newPos.usedGroups;
  1460.   IF newPos.posGroups < dataSys.maxGroup - 50
  1461.   THEN
  1462.     INC (newPos.posGroups, 50);
  1463.   ELSE
  1464.     newPos.posGroups := dataSys.maxGroup;
  1465.   END;
  1466.   (* Jetzt Speicher allozieren *)
  1467.   Storage.ALLOCATE (newPos.pos, LONG(newPos.posGroups) * TSIZE (dataSys.onePos));
  1468.   IF newPos.pos = NIL THEN 
  1469.     newPos.usedGroups := 0;
  1470.     newPos.posGroups := 0;
  1471.     RETURN FALSE 
  1472.   END;
  1473.   FOR i := 0 TO newPos.posGroups -1 DO
  1474.     FOR z := aktuellePos TO unreadCount DO
  1475.       newPos.pos^[i, z] := dataSys.empty
  1476.     END;
  1477.   END;
  1478.   RETURN TRUE;
  1479. END CreatePosArray;
  1480.  
  1481. PROCEDURE GetOnePos (group: CARDINAL; subIdx: dataSys.posType): CARDINAL;
  1482. BEGIN
  1483.   IF group < newPos.usedGroups
  1484.   THEN
  1485.     RETURN newPos.pos^[group, subIdx]
  1486.   END;
  1487.   RETURN dataSys.empty;
  1488. END GetOnePos;
  1489.  
  1490. PROCEDURE SetOnePos (group: CARDINAL; subIdx: dataSys.posType; value: CARDINAL);
  1491.   VAR newSize : CARDINAL;
  1492.       newArray: POINTER TO ARRAY [0..dataSys.maxGroup] OF dataSys.onePos;
  1493.       i       : CARDINAL;
  1494.       z       : dataSys.posType;
  1495. BEGIN
  1496.   IF group >= newPos.posGroups 
  1497.   THEN
  1498.     (* Realloc, Array vergr”žern *)
  1499.     IF newSize < dataSys.maxGroup - 20
  1500.     THEN
  1501.       newSize := group+20;
  1502.     ELSE
  1503.       newSize := dataSys.maxGroup;
  1504.     END;
  1505.     Storage.ALLOCATE (newArray, LONG(newSize) * TSIZE (dataSys.onePos));
  1506.     IF newArray = NIL THEN RETURN END;
  1507.     Block.Clear (newArray, LONG(newSize) * TSIZE (dataSys.onePos));
  1508.     FOR i := newPos.posGroups TO newSize DO
  1509.       FOR z := aktuellePos TO unreadCount DO
  1510.         newPos.pos^[i, z] := dataSys.empty
  1511.       END;
  1512.     END;
  1513.     Block.Copy (newPos.pos, LONG(newPos.posGroups) * TSIZE (dataSys.onePos), newArray);
  1514.     Storage.DEALLOCATE (newPos.pos, 0);
  1515.     newPos.posGroups := newSize;
  1516.     newPos.pos := ADDRESS(newArray);
  1517.   END;
  1518.   newPos.usedGroups := BinOps.HigherCard (newPos.usedGroups, group);
  1519.   newPos.pos^[group, subIdx] := value;
  1520. END SetOnePos;
  1521.  
  1522. PROCEDURE FreeGrPos ();
  1523. BEGIN
  1524.   IF newPos.pos # NIL THEN
  1525.     Storage.DEALLOCATE (newPos.pos, 0);
  1526.     newPos.pos := NIL;
  1527.   END;
  1528. END FreeGrPos;
  1529.  
  1530. PROCEDURE ReadGrPos (VAR isNew : BOOLEAN): BOOLEAN;
  1531.   VAR parName : ARRAY [0..255] OF CHAR;
  1532.       gName   : ARRAY [0..255] OF CHAR;
  1533.       grFile  : fileHandle;
  1534.       pos     : CARDINAL;
  1535.       voidLC  : LONGCARD;
  1536.       size    : LONGCARD;
  1537.       count   : CARDINAL;
  1538. BEGIN
  1539.   Strings.Assign ('gruppen.pos',gName, v.bool);
  1540.   Strings.Concat (MTPaths.DataPath, gName, parName, v.bool);
  1541.   OpenFile (grFile, parName);
  1542.   IF grFile < 0
  1543.   THEN
  1544.     RETURN FALSE
  1545.   END;
  1546.   (* File ist jetzt offen *)
  1547.   (* Erstmal Header lesen und sehen, welche Version wir haben *)
  1548.   ReadBytes (grFile, ADR(grPos), dataSys.dbHeaderLength, voidLC);
  1549.   (* Jetzt den Header testen *)
  1550.   IF (grPos.hdr.CatMagic # dataSys.dbCatMagic) OR
  1551.      (grPos.hdr.Version  # dataSys.dbVersion) OR 
  1552.      ((grPos.hdr.VersionMagic # dataSys.dbVersionMagic) &
  1553.       (grPos.hdr.VersionMagic # dataSys.grPosVersionMagic))
  1554.   THEN
  1555.     (* damit k”nnen wir nichts anfangen, raus hier. *)
  1556.     v.int := MagicDOS.Fclose (grFile);
  1557.     RETURN FALSE
  1558.   END;
  1559.   (* Jetzt mal sehen, welche Version wir haben *)
  1560.   IF grPos.hdr.VersionMagic = dataSys.dbVersionMagic
  1561.   THEN
  1562.     isNew := FALSE;
  1563.     (* Alte Version, also alte Routine nehmen *)
  1564.     voidLC := MagicDOS.Fseek (0, grFile, MagicDOS.SeekStart);
  1565.     ReadBytes (grFile, ADR(grPos), SIZE(grPos), voidLC);
  1566.     v.int := MagicDOS.Fclose (grFile);
  1567.   ELSIF grPos.hdr.VersionMagic = dataSys.grPosVersionMagic
  1568.   THEN
  1569.     isNew := TRUE;
  1570.     (* neue Version vom Gruppen.POS *)
  1571.     (* Gr”že feststellen *)
  1572.     size := FileSize (grFile);
  1573.     v.lcard := MagicDOS.Fseek (0, grFile, MagicDOS.SeekStart);
  1574.     count := SHORT((size-dataSys.dbHeaderLength) DIV TSIZE (dataSys.onePos));
  1575.     DEC (count);  (* Wegen save-Info *)
  1576.     ReadBytes (grFile, ADR(newPos.head), dataSys.dbHeaderLength, voidLC);
  1577.     ReadBytes (grFile, ADR(newPos.save), TSIZE(dataSys.onePos), voidLC);
  1578.     (* Jetzt Speicher allozieren *)
  1579.     IF ~CreatePosArray (count)
  1580.     THEN
  1581.       v.int := MagicDOS.Fclose (grFile);
  1582.       RETURN FALSE
  1583.     END;
  1584.     ReadBytes (grFile, newPos.pos, LONG(count) * TSIZE(dataSys.onePos), voidLC);
  1585.     (* Jetzt ist alles gelesen, wieder schliežen *)
  1586.     v.int := MagicDOS.Fclose (grFile);
  1587.   ELSE
  1588.     v.int := MagicDOS.Fclose (grFile);
  1589.     RETURN FALSE;
  1590.   END;
  1591.   RETURN TRUE;
  1592. END ReadGrPos;
  1593.  
  1594. PROCEDURE WriteGrPos (new: BOOLEAN): BOOLEAN;
  1595.   VAR parName : ARRAY [0..255] OF CHAR;
  1596.       gName   : ARRAY [0..255] OF CHAR;
  1597.       grFile  : fileHandle;
  1598. BEGIN
  1599.   Strings.Assign ('gruppen.pos',gName, v.bool);
  1600.   Strings.Concat (MTPaths.DataPath, gName, parName, v.bool);
  1601.   CreateFile (grFile, parName);
  1602.   IF grFile > 0
  1603.   THEN
  1604.     IF ~new
  1605.     THEN
  1606.       (* Altes Format speichern *)
  1607.       WriteBytes (grFile, ADR(grPos), SIZE(grPos));
  1608.       v.int := MagicDOS.Fclose (grFile);
  1609.     ELSE
  1610.       newPos.head := dataSys.standardHeader;
  1611.       newPos.head.VersionMagic := dataSys.grPosVersionMagic;
  1612.       (* Header schreiben *)
  1613.       WriteBytes (grFile, ADR(newPos.head), dataSys.dbHeaderLength);
  1614.       (* Save-Bereich schreiben *)
  1615.       WriteBytes (grFile, ADR(newPos.save), TSIZE(dataSys.onePos));
  1616.       (* Gruppenbereich schreiben *)
  1617.       WriteBytes (grFile, newPos.pos, LONG (newPos.usedGroups) * TSIZE(dataSys.onePos));
  1618.       v.int := MagicDOS.Fclose (grFile);
  1619.     END;
  1620.   ELSE
  1621.     RETURN FALSE;
  1622.   END;
  1623.   RETURN TRUE;
  1624. END WriteGrPos;
  1625.  
  1626. PROCEDURE updateGrPos();
  1627.   VAR cGrp    : INTEGER;
  1628.       pos     : CARDINAL;
  1629.       isNew   : BOOLEAN;
  1630. BEGIN
  1631.   IF ~ReadGrPos (isNew)
  1632.   THEN
  1633.     RETURN
  1634.   END;
  1635.   (* Jetzt mal sehen, welche Version wir haben *)
  1636.   IF ~isNew
  1637.   THEN
  1638.     cGrp := currentGroup;
  1639.     (*
  1640.     IF currentGroup = dataSys.private 
  1641.     THEN
  1642.       cGrp := 0
  1643.     ELSE
  1644.       cGrp := currentGroup + 1;
  1645.     END;
  1646.     *)
  1647.     pos := grPos.pos[cGrp, aktuellePos];
  1648.     pos := newNums[pos];
  1649.     IF (msgCounter > 0) 
  1650.     THEN
  1651.       IF pos > msgCounter-1
  1652.       THEN 
  1653.         pos := msgCounter-1
  1654.       END;
  1655.     ELSE
  1656.       pos := 1
  1657.     END;
  1658.     grPos.pos[cGrp, aktuellePos] := pos;
  1659.     
  1660.     pos := grPos.pos[cGrp, letztePos];
  1661.     pos := newNums[pos];
  1662.     IF (msgCounter > 0) 
  1663.     THEN
  1664.       IF (pos > msgCounter-1)
  1665.       THEN 
  1666.         pos := msgCounter-1
  1667.       END;
  1668.     ELSE
  1669.       pos := 1;
  1670.     END;
  1671.     grPos.pos[cGrp, letztePos] := pos;
  1672.     
  1673.     pos := grPos.pos[cGrp, neuePos];
  1674.     IF (pos = (msgCounter+deleted+badMsg))
  1675.     THEN
  1676.       pos := msgCounter
  1677.     ELSE
  1678.       pos := (newNums[pos]);
  1679.       IF (msgCounter > 0)
  1680.       THEN
  1681.         IF (pos > msgCounter-1) & (pos # dataSys.empty)
  1682.         THEN pos := msgCounter-1
  1683.         END;
  1684.       ELSE
  1685.         pos := 1;
  1686.       END;
  1687.     END;
  1688.     grPos.pos[cGrp, neuePos] := pos ;
  1689.   
  1690.     grPos.pos[cGrp, unreadPos] := firstUnread;
  1691.     grPos.pos[cGrp, unreadCount] := unreadCounter;
  1692.   
  1693.   ELSE
  1694.     (* neue Version vom Gruppen.POS *)
  1695.     (* Jetzt Daten wandeln *)
  1696.     cGrp := currentGroup;
  1697.  
  1698.     pos := GetOnePos (cGrp, dataSys.aktuellePos);
  1699.     pos := newNums[pos];
  1700.     IF (msgCounter > 0) 
  1701.     THEN
  1702.       IF pos > msgCounter-1
  1703.       THEN 
  1704.         pos := msgCounter-1
  1705.       END;
  1706.     ELSE
  1707.       pos := 1
  1708.     END;
  1709.     SetOnePos (cGrp, dataSys.aktuellePos, pos);
  1710.     
  1711.     pos := GetOnePos (cGrp, dataSys.letztePos);
  1712.     pos := newNums[pos];
  1713.     IF (msgCounter > 0) 
  1714.     THEN
  1715.       IF (pos > msgCounter-1)
  1716.       THEN 
  1717.         pos := msgCounter-1
  1718.       END;
  1719.     ELSE
  1720.       pos := 1;
  1721.     END;
  1722.     SetOnePos (cGrp, dataSys.letztePos, pos);
  1723.     
  1724.     pos := GetOnePos (cGrp, dataSys.neuePos);
  1725.     IF (pos = (msgCounter+deleted+badMsg))
  1726.     THEN
  1727.       pos := msgCounter
  1728.     ELSE
  1729.       pos := (newNums[pos]);
  1730.       IF (msgCounter > 0)
  1731.       THEN
  1732.         IF (pos > msgCounter-1) & (pos # dataSys.empty)
  1733.         THEN pos := msgCounter-1
  1734.         END;
  1735.       ELSE
  1736.         pos := 1;
  1737.       END;
  1738.     END;
  1739.     SetOnePos (cGrp, dataSys.neuePos, pos);
  1740.   
  1741.     SetOnePos (cGrp, dataSys.unreadPos, firstUnread);
  1742.     SetOnePos (cGrp, dataSys.unreadCount, unreadCounter);
  1743.   END;
  1744.   v.bool := WriteGrPos (isNew);
  1745.   FreeGrPos();
  1746. END updateGrPos;
  1747.  
  1748. PROCEDURE deleteInGroup (group: PutzTypes.ptrGrEntry; 
  1749.                          VAR options: PutzTypes.putzOptsRec;
  1750.                          mode: PutzTypes.delMode): BOOLEAN;
  1751.   VAR i : CARDINAL;
  1752.       ch : CHAR;
  1753.       oCurrGr : INTEGER;
  1754.       rdB : LONGCARD;
  1755.       res : INTEGER;
  1756. BEGIN
  1757.   hasFileLocking := MagicCookie.FindCookie (MagicCookie.DosFlock, v.lcard);
  1758.   currentGroup := group^.info^.catNumber;
  1759.   stopDelete := FALSE;
  1760.   CASE mode OF
  1761.     PutzTypes.dFlags    : shouldBeDeleted := deleteByFlags; |
  1762.     PutzTypes.dDate     : shouldBeDeleted := deleteDate;    |
  1763.     PutzTypes.dNum      : shouldBeDeleted := deleteNum;     |
  1764.     PutzTypes.dDateAndNum: shouldBeDeleted := deleteDateAndNum; |
  1765.   ELSE
  1766.     RETURN FALSE
  1767.   END;
  1768.   putzOpts := options;
  1769.   buf := MagicDOS.Malloc (80000L);
  1770.   IF buf = NIL THEN 
  1771.     v.int := mtAlerts.Alert (1, "[3][CATPUTZ:|Kein Speicher fr|Messagebuffer frei!][[Abbruch]");
  1772.     RETURN FALSE 
  1773.   END;
  1774.   openGroup ();
  1775.   IF stopDelete
  1776.   THEN
  1777.     closeGroup;
  1778.     v.bool := MFree (buf);
  1779.     RETURN FALSE
  1780.   END;
  1781.   PutzAction.ReInitActionBox (group^.info^.name^, getGroupMsgs());
  1782.   PutzLog.putTime();
  1783.   PutzLog.WriteString ("Gruppenwechsel zu ");
  1784.   PutzLog.WriteString (group^.info^.name^);
  1785.   PutzLog.WriteString (", ");
  1786.   PutzLog.WriteCard (getGroupMsgs());
  1787.   PutzLog.WriteString (" Messages zu bearbeiten mit ");
  1788.   PutzLog.WriteCard (group^.preBytes);
  1789.   PutzLog.WriteLine (" Bytes.");
  1790.   stopDelete := ~PutzAction.TellAction (0,0);
  1791.   msgCounter := 0;
  1792.   partDeleted := 0;
  1793.   badMsg := 0;
  1794.   deleted := 0;
  1795.   firstUnread := dataSys.empty;
  1796.   unreadCounter := 0;
  1797.   (* newNums initialisieren *)
  1798.   FOR i := 0 TO 65535 DO
  1799.     newNums[i] := dataSys.empty;
  1800.   END;
  1801.   (* Tab und Par-File lesen *)
  1802.   BufferTabAndPar();
  1803.   (* Datenfile buffern *)
  1804.   BufferDatFile();
  1805.   PutzAction.ShowBuffStatus (tabBuffered, parBuffered, datBuffered);
  1806.   PutzLog.putTime();
  1807.   IF tabBuffered
  1808.   THEN 
  1809.     PutzLog.WriteString ("TAB-File gebuffert");
  1810.   ELSE
  1811.     PutzLog.WriteString ("Nichts gebuffert");
  1812.   END;
  1813.   IF parBuffered
  1814.   THEN 
  1815.     PutzLog.WriteString (", PAR-File gebuffert");
  1816.   END;
  1817.   IF datBuffered
  1818.   THEN
  1819.     PutzLog.WriteString (", DAT-File gebuffert");
  1820.   END;
  1821.   PutzLog.WriteLn;
  1822.   IF AnzMessages > 0 THEN
  1823.     (* Neue Files anlegen *)
  1824.     createNewFiles;
  1825.     IF stopDelete THEN
  1826.       closeGroup;
  1827.       v.int := MagicDOS.Fclose (newDat);
  1828.       v.int := MagicDOS.Fclose (newTab);
  1829.       v.int := MagicDOS.Fclose (newPar);
  1830.       deleteNewFiles;
  1831.       killBuffer;
  1832.       v.bool := MFree (buf);
  1833.       RETURN FALSE
  1834.     END;
  1835.     (* dbHeader in par-File schreiben *)
  1836.     IF ~parBuffered
  1837.     THEN
  1838.       ReadBytes (parFile, buf, dataSys.dbHeaderLength, rdB);
  1839.       WriteBytes (newPar, buf, dataSys.dbHeaderLength);
  1840.     END;
  1841.     IF stopDelete THEN
  1842.       closeGroup;
  1843.       v.int := MagicDOS.Fclose (newDat);
  1844.       v.int := MagicDOS.Fclose (newTab);
  1845.       v.int := MagicDOS.Fclose (newPar);
  1846.       deleteNewFiles;
  1847.       killBuffer;
  1848.       v.bool := MFree (buf);
  1849.       RETURN FALSE
  1850.     END;
  1851.     (* Writebuffer anlegen *)
  1852.     MakeWriteBuffer(newDat);
  1853.     (* L”schen starten *)
  1854.     res := doDelete();
  1855.     IF datBuffered THEN v.bool := MFree (datBuffer) END;
  1856.     IF stopDelete OR (res > 0) THEN
  1857.       closeGroup;
  1858.       (* Writebuffer schliežen *)
  1859.       CloseWriteBuffer (newDat);
  1860.       v.int := MagicDOS.Fclose (newDat);
  1861.       v.int := MagicDOS.Fclose (newTab);
  1862.       v.int := MagicDOS.Fclose (newPar);
  1863.       deleteNewFiles;
  1864.       killBuffer;
  1865.       v.bool := MFree (buf);
  1866.       IF res > 0 
  1867.       THEN
  1868.         group^.postMsgs := group^.preMsgs;
  1869.         group^.postBytes:= group^.preBytes;
  1870.       END;
  1871.       RETURN ~stopDelete
  1872.     END;
  1873.     (* Alte Files schliežen *)
  1874.     IF parBuffered THEN FlushParam (newPar, newParArray); END;
  1875.     IF stopDelete THEN
  1876.       closeGroup;
  1877.       (* Writebuffer schliežen *)
  1878.       CloseWriteBuffer (newDat);
  1879.       v.int := MagicDOS.Fclose (newDat);
  1880.       v.int := MagicDOS.Fclose (newTab);
  1881.       v.int := MagicDOS.Fclose (newPar);
  1882.       deleteNewFiles;
  1883.       killBuffer;
  1884.       v.bool := MFree (buf);
  1885.       RETURN FALSE
  1886.     END;
  1887.     IF tabBuffered THEN
  1888.       FlushTab (newTab, newTabArray);
  1889.       v.bool := MFree (tabArray);
  1890.       v.bool := MFree (newTabArray);
  1891.     END;
  1892.     (* Writebuffer schliežen *)
  1893.     CloseWriteBuffer (newDat);
  1894.     IF stopDelete THEN
  1895.       v.int := MagicDOS.Fclose (newDat);
  1896.       v.int := MagicDOS.Fclose (newTab);
  1897.       v.int := MagicDOS.Fclose (newPar);
  1898.       deleteNewFiles;
  1899.       v.bool := MFree (buf);
  1900.       RETURN FALSE
  1901.     END;
  1902.     (* Summeneintrag neu setzen *)
  1903.     group^.badDel :=  badMsg;
  1904.     group^.totalDel := deleted;
  1905.     group^.partDel :=  partDeleted;
  1906.     group^.postMsgs := msgCounter;
  1907.     group^.postBytes:= FileSize (newDat);
  1908.     INC (totalEntry.badDel, badMsg);
  1909.     INC (totalEntry.totalDel, deleted);
  1910.     INC (totalEntry.partDel, partDeleted);
  1911.     INC (totalEntry.postMsgs, msgCounter);
  1912.     INC (totalEntry.postBytes, group^.postBytes);
  1913.     closeGroup;
  1914.     v.int := MagicDOS.Fclose (newDat);
  1915.     v.int := MagicDOS.Fclose (newTab);
  1916.     v.int := MagicDOS.Fclose (newPar);
  1917.     IF stopDelete THEN
  1918.       deleteNewFiles;
  1919.       v.bool := MFree (buf);
  1920.       RETURN FALSE
  1921.     END;
  1922.     stopDelete := ~PutzAction.TellAction (2,AnzMessages);
  1923.     IF stopDelete THEN
  1924.       deleteNewFiles;
  1925.       v.bool := MFree (buf);
  1926.       RETURN FALSE
  1927.     END;
  1928.     (* Kommentarverkettung neu erstellen *)
  1929.     PutzLog.putTime();
  1930.     PutzLog.WriteLine ("Kommentarverkettung neu aufbauen");
  1931.     linkNewPar();
  1932.     v.int := MagicDOS.Fclose (newPar);
  1933.     (* Gruppen.POS updaten *)
  1934.     updateGrPos;
  1935.     (* Alte Files l”schen und neue umbenennen *)
  1936.     PutzLog.putTime();
  1937.     PutzLog.WriteLine ("Gruppendateien umkopieren");
  1938.     stopDelete := ~PutzAction.TellAction (3,AnzMessages);
  1939.     IF stopDelete THEN
  1940.       deleteNewFiles;
  1941.       v.bool := MFree (buf);
  1942.       RETURN FALSE
  1943.     END;
  1944.     makeNewNames;
  1945.     PutzLog.putTime();
  1946.     PutzLog.WriteString ("Gruppe ");
  1947.     PutzLog.WriteString (group^.info^.name^);
  1948.     PutzLog.WriteString (" geschlossen, Messages nachher: ");
  1949.     PutzLog.WriteCard (group^.postMsgs);
  1950.     PutzLog.WriteString (", Bytes nachher: ");
  1951.     PutzLog.WriteCard (group^.postBytes);
  1952.     PutzLog.WriteLn;
  1953.     PutzLog.WriteLn;
  1954.   ELSE
  1955.     closeGroup;
  1956.   END;
  1957.   v.bool := MFree (buf);
  1958.   RETURN TRUE;
  1959. END deleteInGroup;
  1960.  
  1961. PROCEDURE deleteGroup (group : PutzTypes.ptrGrEntry; noConfirm: BOOLEAN): BOOLEAN;
  1962.   VAR i, j    : INTEGER;
  1963.       maxNum  : CARDINAL;
  1964.       dat2Name, 
  1965.       tab2Name,
  1966.       par2Name,
  1967.       datName,
  1968.       tabName,
  1969.       parName : PutzTypes.FileStr;
  1970.       gName   : PutzTypes.PathStr;
  1971.       bRead   : LONGCARD;
  1972.       res     : INTEGER;
  1973.       pos     : CARDINAL;
  1974.       voidLC  : LONGCARD;
  1975.       found   : BOOLEAN;
  1976.       msg     : PutzTypes.FileStr;
  1977.       grFile  : fileHandle;
  1978.       mE      : PutzTypes.ptrGrEntry;
  1979.       isNew   : BOOLEAN;
  1980. BEGIN
  1981.   IF ~noConfirm
  1982.   THEN
  1983.     Strings.Assign ('[2][Soll die Gruppe|', msg, v.bool);
  1984.     Strings.Append (group^.info^.name^, msg, v.bool);
  1985.     Strings.Append (' wirklich|gel”scht werden?][[Ja|[Nein]', msg, v.bool);
  1986.     IF mtAlerts.Alert (2, msg) = 2
  1987.     THEN
  1988.       RETURN FALSE
  1989.     END;
  1990.   END;
  1991.   (* Gruppe l”schen *)
  1992.   (* Erstmal Gruppe mit h”chster Nummer herausfinden *)
  1993.   v.bool := GroupSelect.GroupNumber ('%%&%Ý$(', maxNum);
  1994.   DEC (maxNum);
  1995.  
  1996.   (* Dateien l”schen und umbenennen *)
  1997.   buildName (group^.info^.catNumber, gName);
  1998.   Strings.Concat (MTPaths.DataPath, gName, datName, v.bool);
  1999.   Strings.Assign (datName, parName, v.bool);
  2000.   Strings.Assign (datName, tabName, v.bool);
  2001.   Strings.Append ('.par',parName, v.bool);
  2002.   Strings.Append ('.dat',datName, v.bool);
  2003.   Strings.Append ('.tab',tabName, v.bool);
  2004.   (* Dateien l”schen *)
  2005.   IF NOT (MagicDOS.Fdelete (datName) &
  2006.           MagicDOS.Fdelete (parName) &
  2007.           MagicDOS.Fdelete (tabName))
  2008.   THEN
  2009.     v.int := mtAlerts.Alert (1,"[3][CATPUTZ:|Konnte nicht alle|Dateien l”schen!|M”glicherweise ist die|Gruppe jetzt besch„digt.][[Abbruch]");
  2010.     RETURN TRUE;
  2011.   END;
  2012.   GroupSelect.DeleteGroup (group^.info^.name^);
  2013.   
  2014.   IF INTEGER(maxNum) > group^.info^.catNumber
  2015.   THEN
  2016.     (* Von der letzten Gruppe die Nummer noch „ndern 
  2017.      * und die Dateien umbenennen 
  2018.      *)
  2019.     buildName (maxNum, gName);
  2020.     Strings.Concat (MTPaths.DataPath, gName, dat2Name, v.bool);
  2021.     Strings.Assign (dat2Name, par2Name, v.bool);
  2022.     Strings.Assign (dat2Name, tab2Name, v.bool);
  2023.     Strings.Append ('.par',par2Name, v.bool);
  2024.     Strings.Append ('.dat',dat2Name, v.bool);
  2025.     Strings.Append ('.tab',tab2Name, v.bool);
  2026.     (* Jetzt Dateien umbennen *)
  2027.     IF (MagicDOS.Frename (tab2Name, tabName) # 0)
  2028.     OR (MagicDOS.Frename (par2Name, parName) # 0)
  2029.     OR (MagicDOS.Frename (dat2Name, datName) # 0)
  2030.     THEN
  2031.       v.int := mtAlerts.Alert (1,"[3][CATPUTZ:|Konnte Gruppendateien|nicht umbenennen!|M”glicherweise ist die|Datenbank jetzt besch„digt!][[Abbruch]");
  2032.       RETURN TRUE;
  2033.     END;
  2034.     (* Jetzt die gruppe in der Putzliste suchen *)
  2035.     Lists.ResetList (putzList);
  2036.     mE := Lists.NextEntry (putzList);
  2037.     WHILE mE # NIL DO
  2038.       IF mE^.info^.catNumber = INTEGER(maxNum)
  2039.       THEN
  2040.         mE^.info^.catNumber := group^.info^.catNumber;
  2041.         GroupSelect.SetNewCatNumber (mE^.info^.name^, group^.info^.catNumber);
  2042.         mE := NIL;
  2043.       ELSE
  2044.         mE := Lists.NextEntry (putzList);
  2045.       END;
  2046.     END;
  2047.   ELSE
  2048.     (* Gruppen.INF sichern *)
  2049.     GroupSelect.SaveGruppenInf();
  2050.   END;
  2051.   
  2052.   (* Jetzt gruppen.pos noch „ndern *)
  2053.   IF ReadGrPos (isNew)
  2054.   THEN
  2055.     (* Jetzt ist das geladen, Žnderungen vornehmen *)
  2056.     IF ~isNew
  2057.     THEN
  2058.       (* Altes GRUPPEN.POS, alte Routine *)
  2059.       grPos.pos[group^.info^.catNumber] := grPos.pos[maxNum];
  2060.       grPos.pos[maxNum,aktuellePos] := dataSys.empty;
  2061.       grPos.pos[maxNum,neuePos] := 0;
  2062.       grPos.pos[maxNum,letztePos] := 0;
  2063.       grPos.pos[maxNum,unreadPos] := 0;
  2064.       grPos.pos[maxNum,unreadCount] := 0;
  2065.     ELSE
  2066.       (* neues Gruppen.POS, etwas anders „ndern *)
  2067.       newPos.pos^[group^.info^.catNumber] := newPos.pos^[maxNum];
  2068.       DEC (newPos.usedGroups);
  2069.     END;
  2070.     v.bool := WriteGrPos (isNew);
  2071.     FreeGrPos();
  2072.   END;
  2073.   
  2074.   (* Ge„nderte Gruppenliste von CAT noch sichern *)
  2075.   v.bool := GroupSelect.SaveGroupList();
  2076.   (* Ok, die externen Arbeiten sind fertig. Jetzt folgt der interne Kram *)
  2077.   (* Eintrag noch aus der Putzliste l”schen *)
  2078.   Lists.ResetList (putzList);
  2079.   mE := Lists.NextEntry (putzList);
  2080.   WHILE mE # group DO 
  2081.     mE := Lists.NextEntry (putzList);
  2082.   END;
  2083.   Lists.RemoveEntry (putzList, v.bool);
  2084.   Storage.DEALLOCATE (mE, 0);
  2085.   
  2086.   RETURN TRUE
  2087. END deleteGroup;
  2088.  
  2089. END PutzGroup.
  2090.